Group Predictions

Row

Win percentage for the week

Season Win Percentage

Games Correct

160

Games Picked

235

Number of predictions

12

Row

This Week’s Predictions
Game Prediction Winner Correct Correct Votes Correct Percent
1 Seattle Seahawks Seattle Seahawks Yes 7 0.5833
2 Philadelphia Eagles Philadelphia Eagles Yes 12 1.0000
3 Chicago Bears Chicago Bears Yes 10 0.8333
4 Buffalo Bills Buffalo Bills Yes 12 1.0000
5 Tie Cincinnati Bengals -- 6 0.5000
6 Kansas City Chiefs Tennessee Titans No 4 0.3333
7 Dallas Cowboys Los Angeles Chargers No 5 0.4167
8 Minnesota Vikings Minnesota Vikings Yes 11 0.9167
9 New Orleans Saints New Orleans Saints Yes 12 1.0000
10 Tampa Bay Buccaneers Carolina Panthers No 4 0.3333
11 Atlanta Falcons Atlanta Falcons Yes 8 0.6667
12 Denver Broncos Jacksonville Jaguars No 2 0.1667
13 Houston Texans Houston Texans Yes 11 0.9167
14 Detroit Lions Pittsburgh Steelers No 4 0.3333
15 New England Patriots New England Patriots Yes 10 0.8333
16 San Francisco 49ers San Francisco 49ers Yes 7 0.5833

Individual Predictions

row

Individual Table

Individual Results
Week 16
Name
Weekly # Correct
Percent Weeks Picked Season Percent Adj Season Percent Season Trend
Week 1 Week 2 Week 3 Week 4 Week 5 Week 6 Week 7 Week 8 Week 9 Week 10 Week 11 Week 12 Week 13 Week 14 Week 15 Week 16
Daniel Baller 11 12 10 10 5 9 11 9 8 8 8 10 NA 8 11 14 0.8750 15 0.6575 0.6164
Christina Neal 9 8 7 5 NA NA NA NA NA NA 12 NA 10 12 12 13 0.8125 9 0.6471 0.3640
Mariah Boyce 10 12 9 7 6 10 5 5 NA 7 10 8 10 7 9 13 0.8125 15 0.5792 0.5430
Angus Ferrell 9 12 10 NA NA 11 10 9 11 11 8 9 10 6 8 11 0.6875 14 0.6585 0.5762
Bonvie Fosam 11 11 NA 9 5 7 10 8 12 4 10 10 NA 9 NA 11 0.6875 13 0.6126 0.4977
Sean Fraser 9 12 9 9 7 NA 9 8 10 10 13 9 NA NA NA 10 0.6250 12 0.6534 0.4900
Elliott Clark 9 11 8 9 7 10 11 8 9 9 12 10 11 6 11 10 0.6250 16 0.6426 0.6426
Justin Hartung 12 11 10 9 NA 7 11 7 11 9 7 6 10 9 10 10 0.6250 15 0.6290 0.5897
Harold Sampson 12 12 10 11 5 9 12 9 9 9 12 12 10 5 8 9 0.5625 16 0.6553 0.6553
Justin Mclellan 12 12 10 7 6 11 12 7 9 8 9 10 8 10 8 9 0.5625 16 0.6298 0.6298
Abby Wilton 9 11 NA 7 5 10 12 8 10 8 8 12 10 9 8 9 0.5625 15 0.6154 0.5769
Michael Hoffman 11 8 13 10 4 9 11 9 4 10 9 10 9 9 11 6 0.3750 16 0.6085 0.6085
Peter Previte 12 12 10 10 NA NA NA NA NA NA NA NA NA NA NA NA 0.0000 4 0.7097 0.1774
Brandon Des Jardins 14 12 12 10 3 NA 13 9 9 10 12 NA NA NA NA NA 0.0000 10 0.7075 0.4422
Bradley Whitehall 6 11 12 10 9 9 11 11 NA 10 14 11 NA NA NA NA 0.0000 11 0.7037 0.4838
Christina Shumate 14 11 12 8 8 NA NA NA NA NA NA NA NA NA NA NA 0.0000 5 0.6974 0.2179
Brenna Friedel 11 11 NA NA NA NA NA NA NA NA NA NA NA NA NA NA 0.0000 2 0.6875 0.0859
Adrienne Saltik NA 12 11 8 9 10 10 6 11 NA 13 8 10 10 12 NA 0.0000 13 0.6842 0.5559
Dylan Soule 8 13 8 11 NA NA 13 NA 9 9 11 9 10 7 10 NA 0.0000 12 0.6629 0.4972
Peter Meyers 14 13 9 7 5 11 11 5 NA NA NA NA NA NA NA NA 0.0000 8 0.6303 0.3152
Grace Chao 10 13 9 9 7 9 NA 7 10 NA NA NA NA NA NA NA 0.0000 8 0.6271 0.3136
Matthew Lohff 11 13 10 9 NA 9 9 6 8 9 NA NA NA 8 NA NA 0.0000 10 0.6259 0.3912
Kraig Sheetz 10 NA 10 NA 6 NA 10 7 NA 10 NA NA NA NA NA NA 0.0000 6 0.6163 0.2311
Aaron Johnston 12 11 10 7 8 7 10 8 NA NA NA NA NA 8 NA NA 0.0000 9 0.6090 0.3426
Benjamin Siegel 12 11 9 8 6 8 10 NA 8 NA NA NA NA NA NA NA 0.0000 8 0.6000 0.3000
Mary Beth Inks 11 NA 10 NA 6 NA 11 8 9 5 9 8 8 NA NA NA 0.0000 10 0.5862 0.3664
Lucas Miller 11 9 NA 10 6 9 NA NA NA NA NA NA NA 8 NA NA 0.0000 6 0.5824 0.2184
Roni Brown 6 NA 10 NA 7 NA NA NA 10 NA NA NA NA 7 NA NA 0.0000 5 0.5556 0.1736
Elisa Sun 11 NA NA NA 5 NA NA NA NA NA NA NA NA NA NA NA 0.0000 2 0.5333 0.0667

Season Leaderboard

Season Leaderboard (Season Percent)
Week 16
Season Rank Name Donuts Won Weeks Picked Season Percent Adj Season Percent Season Trend
1 Peter Previte 0 4 0.7097 0.1774
2 Brandon Des Jardins 2 10 0.7075 0.4422
3 Bradley Whitehall 3 11 0.7037 0.4838
4 Christina Shumate 1 5 0.6974 0.2179
5 Brenna Friedel 0 2 0.6875 0.0859
6 Adrienne Saltik 2 13 0.6842 0.5559
7 Dylan Soule 3 12 0.6629 0.4972
8 Angus Ferrell 2 14 0.6585 0.5762
9 Daniel Baller 1 15 0.6575 0.6164
10 Harold Sampson 2 16 0.6553 0.6553
11 Sean Fraser 0 12 0.6534 0.4900
12 Christina Neal 2 9 0.6471 0.3640
13 Elliott Clark 1 16 0.6426 0.6426
14 Peter Meyers 3 8 0.6303 0.3152
15 Justin Mclellan 1 16 0.6298 0.6298
16 Justin Hartung 0 15 0.6290 0.5897
17 Grace Chao 1 8 0.6271 0.3136
18 Matthew Lohff 1 10 0.6259 0.3912
19 Kraig Sheetz 0 6 0.6163 0.2311
20 Abby Wilton 1 15 0.6154 0.5769
21 Bonvie Fosam 1 13 0.6126 0.4977
22 Aaron Johnston 0 9 0.6090 0.3426
23 Michael Hoffman 1 16 0.6085 0.6085
24 Benjamin Siegel 0 8 0.6000 0.3000
25 Mary Beth Inks 0 10 0.5862 0.3664
26 Lucas Miller 0 6 0.5824 0.2184
27 Mariah Boyce 0 15 0.5792 0.5430
28 Roni Brown 0 5 0.5556 0.1736
29 Elisa Sun 0 2 0.5333 0.0667

Adjusted Season Leaderboard

Season Leaderboard (Adjusted Season Percent)
Week 16
Season Rank Name Donuts Won Weeks Picked Season Percent Adj Season Percent Season Trend
1 Harold Sampson 2 16 0.6553 0.6553
2 Elliott Clark 1 16 0.6426 0.6426
3 Justin Mclellan 1 16 0.6298 0.6298
4 Daniel Baller 1 15 0.6575 0.6164
5 Michael Hoffman 1 16 0.6085 0.6085
6 Justin Hartung 0 15 0.6290 0.5897
7 Abby Wilton 1 15 0.6154 0.5769
8 Angus Ferrell 2 14 0.6585 0.5762
9 Adrienne Saltik 2 13 0.6842 0.5559
10 Mariah Boyce 0 15 0.5792 0.5430
11 Bonvie Fosam 1 13 0.6126 0.4977
12 Dylan Soule 3 12 0.6629 0.4972
13 Sean Fraser 0 12 0.6534 0.4900
14 Bradley Whitehall 3 11 0.7037 0.4838
15 Brandon Des Jardins 2 10 0.7075 0.4422
16 Matthew Lohff 1 10 0.6259 0.3912
17 Mary Beth Inks 0 10 0.5862 0.3664
18 Christina Neal 2 9 0.6471 0.3640
19 Aaron Johnston 0 9 0.6090 0.3426
20 Peter Meyers 3 8 0.6303 0.3152
21 Grace Chao 1 8 0.6271 0.3136
22 Benjamin Siegel 0 8 0.6000 0.3000
23 Kraig Sheetz 0 6 0.6163 0.2311
24 Lucas Miller 0 6 0.5824 0.2184
25 Christina Shumate 1 5 0.6974 0.2179
26 Peter Previte 0 4 0.7097 0.1774
27 Roni Brown 0 5 0.5556 0.1736
28 Brenna Friedel 0 2 0.6875 0.0859
29 Elisa Sun 0 2 0.5333 0.0667

Data

---
title: "2025 NFL Moneyline Picks"
output: 
  flexdashboard::flex_dashboard:
    theme:
      version: 4
      bootswatch: spacelab
    orientation: rows
    vertical_layout: fill
    social: ["menu"]
    source_code: embed
    navbar:
      - { title: "Created by: Daniel Baller", icon: "fa-github", href: "https://github.com/danielpballer"  }
---


```{r setup, include=FALSE}
#    source_code: embed
options(show.error.messages = FALSE)
library(flexdashboard)
library(tidyverse)
library(data.table)
library(formattable)
library(ggpubr)
library(ggrepel)
library(gt)
library(glue)
library(ggthemes)
library(hrbrthemes)
library(sparkline)
library(plotly)
library(htmlwidgets)
#library(mdthemes)
library(ggtext)
library(ggnewscale)
library(DT)
source("./Functions/functions2.R")

thematic::thematic_rmd(font = "auto")

# Use line 211 if you need to hard code any losses for a week
```

```{r Reading in our picks files, include=FALSE}
current_week = 16 #Set what week it is
week_1 = read_csv("./CSV_Data_Files/2025 NFL Week 1.csv")%>% 
  mutate(Name = str_to_title(Name))
week_2 = read_csv("./CSV_Data_Files/2025 NFL Week 2.csv")%>% 
 mutate(Name = str_to_title(Name))
week_3 = read_csv("./CSV_Data_Files/2025 NFL Week 3.csv")%>% 
 mutate(Name = str_to_title(Name))
week_4 = read_csv("./CSV_Data_Files/2025 NFL Week 4.csv")%>%
 mutate(Name = str_to_title(Name))
week_5 = read_csv("./CSV_Data_Files/2025 NFL Week 5.csv")%>% 
 mutate(Name = str_to_title(Name))
week_6 = read_csv("./CSV_Data_Files/2025 NFL Week 6.csv")%>% 
 mutate(Name = str_to_title(Name))
week_7 = read_csv("./CSV_Data_Files/2025 NFL Week 7.csv")%>% 
 mutate(Name = str_to_title(Name))
week_8 = read_csv("./CSV_Data_Files/2025 NFL Week 8.csv")%>% 
 mutate(Name = str_to_title(Name))
week_9 = read_csv("./CSV_Data_Files/2025 NFL Week 9.csv")%>% 
 mutate(Name = str_to_title(Name))
week_10 = read_csv("./CSV_Data_Files/2025 NFL Week 10.csv")%>% 
 mutate(Name = str_to_title(Name))
week_11 = read_csv("./CSV_Data_Files/2025 NFL Week 11.csv")%>% 
 mutate(Name = str_to_title(Name))
week_12 = read_csv("./CSV_Data_Files/2025 NFL Week 12.csv")%>% 
 mutate(Name = str_to_title(Name))
week_13 = read_csv("./CSV_Data_Files/2025 NFL Week 13.csv")%>% 
 mutate(Name = str_to_title(Name))
week_14 = read_csv("./CSV_Data_Files/2025 NFL Week 14.csv")%>% 
 mutate(Name = str_to_title(Name))
week_15 = read_csv("./CSV_Data_Files/2025 NFL Week 15.csv")%>% 
 mutate(Name = str_to_title(Name))
week_16 = read_csv("./CSV_Data_Files/2025 NFL Week 16.csv")%>% 
 mutate(Name = str_to_title(Name))
# week_17 = read_csv("./CSV_Data_Files/2024 NFL Week 17.csv")%>% 
#   mutate(Name = str_to_title(Name))
# week_18 = read_csv("./CSV_Data_Files/2024 NFL Week 18.csv")%>% 
#   mutate(Name = str_to_title(Name))
# week_19 = read_csv("./CSV_Data_Files/2024 NFL Wild Card.csv")%>% 
#   mutate(Name = str_to_title(Name))
# week_20 = read_csv("./CSV_Data_Files/2024 NFL Divisional Week.csv")%>% 
#   mutate(Name = str_to_title(Name))
# week_21 = read_csv("./CSV_Data_Files/2024 NFL Conference Round.csv")%>% 
# mutate(Name = str_to_title(Name))
# week_22 = read_csv("./CSV_Data_Files/2024 NFL Super Bowl.csv")%>% 
#   mutate(Name = str_to_title(Name))

#reading in scores
Scores = read_csv(glue::glue("./CSV_Data_Files/NFL_Scores_{current_week}.csv")) 

#reading in CBS Prediction Records
cbs = read_csv(glue::glue("./CSV_Data_Files/CBS_Experts_{current_week}.csv")) %>% 
  mutate(Percent = round(Percent,4))
cbs_season = read_csv(glue::glue("./CSV_Data_Files/CBS_Experts_Season_{current_week}.csv"))

#reading in ESPN Prediction Records
espn = read_csv(glue::glue("./CSV_Data_Files/ESPN_Experts_{current_week}.csv"))%>% 
  mutate(Percent = round(Percent,4))
espn_season = read_csv(glue::glue("./CSV_Data_Files/ESPN_Experts_Season_{current_week}.csv"))%>% 
  mutate(Percent = round(Percent,4))

#Odds not working for the 2024 season.  Need to fix scrape code for next year.
#Reading in the moneyline odds for each team and cleaning the team names
# odds_wk1 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_1.csv"))
# odds_wk2 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_2.csv"))
# odds_wk3 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_3.csv"))
# odds_wk4 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_4.csv"))
# odds_wk5 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_5.csv"))
# odds_wk6 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_6.csv"))
# odds_wk7 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_7.csv"))
# odds_wk8 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_8.csv"))
# odds_wk9 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_9.csv"))
# odds_wk10 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_10.csv"))
# odds_wk11 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_11.csv"))
# odds_wk12 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_12.csv"))
# odds_wk13 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_13.csv"))
# odds_wk14 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_14.csv"))
# odds_wk15 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_15.csv"))
# odds_wk16 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_16.csv"))
# odds_wk17 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_17.csv"))
# odds_wk18 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_18.csv"))
# odds_wk19 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_19.csv"))
# odds_wk20 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_20.csv"))
# odds_wk21 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_21.csv"))
# odds_wk22 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_22.csv"))

####################UPDATE THESE###############################
inst.picks = list(week_1, week_2, week_3, week_4, week_5, week_6, week_7, week_8, week_9, week_10, week_11, week_12, week_13, week_14, week_15, week_16) #, week_17, week_18, week_19, week_20, week_21, week_22) #add in the additional weeks
#odds = rbind(odds_wk1, odds_wk2, odds_wk3, odds_wk4, odds_wk5, odds_wk6, odds_wk7, odds_wk8,
#              odds_wk9, odds_wk10, odds_wk11, odds_wk12) #add in the additional weeks
####################END OF UPDATE##############################

weeks = as.list(seq(1:current_week)) #creating a list of each week number
```

```{r read in scores clean data, include=FALSE}
#Cleaning Odds Data
# cl_odds = odds_cleaning(odds)

#Cleaning scores data
Scores = cleaning2(Scores)

#creating a list of winners for each week
winners = map(weeks, weekly_winners)

#creating a vector of this weeks winners
this_week = pull(winners[[length(winners)]])  

#Getting the number of games for each week
weekly_number_of_games = map_dbl(weeks, week_number_games)
```

```{r Group Predictions, include=FALSE}
#Creating the list of everyones predictions each week.
games = map(inst.picks, games_fn)

#Creating the prediction table.  
pred_table = map(games, pred_table_fn)

#Adding who won to the predictions
with_winners = map2(pred_table, winners, adding_winners)

#Creating results for each week.
results = map2(with_winners,weekly_number_of_games, results_fn)
```


```{r Displaying Group Results, echo=FALSE}
#Displaying the group results

inst_group_table = results[[length(results)]] %>% gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("This Week's Predictions"),
    #subtitle = md(glue("Week {length(results)}"))
    ) %>% 
   tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(Correct),
      rows = Correct =="No"
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(Correct),
      rows = Correct =="Yes"
    )) %>% 
  tab_options(
    data_row.padding = px(3),
    container.height = "100%"
   )
```

```{r Weekly and season Group Results, include=FALSE}
# Printing the weekly and season win percentage     

#how many games correct, incorrect, and not picked each week
weekly_group_correct = map(results, weekly_group_correct_fn)  

#how many games were picked each week
weekly_games_picked = map2(weekly_group_correct, weekly_number_of_games, weekly_games_picked_fn)

#Calculating the number of correct picks for each week
weekly_group_correct_picks = map(weekly_group_correct, weekly_group_correct_picks_fn)

# Code to manually hard code in week where we get 0 games correct
# ##### Remove this line before next season 
#weekly_group_correct_picks[[21]]=0

#Calculating weekly win percentage
weekly_win_percentage = map2(weekly_group_correct_picks, weekly_games_picked, weekly_win_percentage_fn)

#Calculating season win percentage
season_win_percentage = round(sum(unlist(weekly_group_correct_picks))/sum(unlist(weekly_games_picked)),4)

#Calculating number of games picked this season
season_games = sum(unlist(weekly_games_picked))

#calculating season wins
season_wins = sum(unlist(weekly_group_correct_picks))

#calculating the number of people who picked this week
Total = dim(inst.picks[[length(weeks)]])[1]
```

```{r plotting group results, include=FALSE}
#Previous Weeks
group_season_for_plotting = unlist(weekly_win_percentage) %>% as.data.frame() %>% 
  rename(`Win Percentage` = ".") %>% 
  add_column(Week = unlist(weeks))
```

```{r Plotting the group results, echo=FALSE}
inst_group_season_plot = group_season_for_plotting %>% 
ggplot(aes(x = as.factor(Week), y = `Win Percentage`))+
  geom_point()+
  geom_path(aes(x = Week))+
  ylim(c(0, 1)) +
  xlab("NFL Week") + 
  ylab("Correct Percentage")+
  ggtitle("Weekly Group Correct Percentage")+
  theme_classic()+
  theme(plot.title = element_text(hjust = 0.5, size = 18))
```

```{r beating cbs week, include=FALSE}
#Creating a list of correct percentages for each week.
cbs_weekly_percent = map(weeks, cbs_percent)

#Creating a list of how many cbs experts we beat each week.
cbs_experts_beat = map2(cbs_weekly_percent, weekly_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
cbs_experts_total = map(cbs_weekly_percent, experts_tot)
```

```{r beating cbs season, include=FALSE}
#Creating a list of correct percentages for each week.
cbs_season_percent = map(weeks, cbs_season_percent)

#Creating a list of how many cbs experts we beat each week.
cbs_experts_beat_season = map2(cbs_season_percent, season_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
cbs_experts_season_total = map(cbs_season_percent, experts_tot)
```

```{r beating ESPN week, include=FALSE}
#Creating a list of correct percentages for each week.
espn_weekly_percent = map(weeks, espn_percent)

#Creating a list of how many cbs experts we beat each week.
espn_experts_beat = map2(espn_weekly_percent, weekly_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
espn_experts_total = map(espn_weekly_percent, experts_tot)
```

```{r beating ESPN season, include=FALSE}
#Creating a list of correct percentages for each week.
espn_season_percent = map(weeks, espn_season_percent)

#Creating a list of how many cbs experts we beat each week.
espn_experts_beat_season = map2(espn_season_percent, season_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
espn_experts_season_total = map(espn_season_percent, experts_tot)
```

```{r individual results, include=FALSE}
#Creating a list of individual results for each week.
weekly_indiv = pmap(list(inst.picks, winners, weeks), indiv_weekly_pred)

#Combining each week into one dataframe and calculating percentage Correct for this week.  
full_season = weekly_indiv %>% reduce(full_join, by = "Name") %>% 
  mutate(Percent = round(pull(.[,ncol(.)]/weekly_number_of_games[[length(weekly_number_of_games)]]),4)) 

#Creating a dataframe with only the weekly picks
a = full_season %>% select(starts_with("Week"))

#Creating a vector of how many weeks each person picked over the season
tot_week = NULL
help = NULL
for (i in 1:dim(a)[1]){
  for(j in 1:length(a)){
    help[j] = ifelse(is.na(a[i,j])==T,0,1)
    tot_week[i] = sum(help)
  }
}

#Creating a vector of how many games each person picked over the season
tot_picks= NULL
help = NULL
for (i in 1:dim(a)[1]){
  for(j in 1:length(a)){
    help[j] = unlist(weekly_games_picked)[j]*ifelse(is.na(a[i,j])==T,0,1)
    tot_picks[i] = sum(help)
  }
}

#Creatign a vector of how many games each person picked correct over the season
tot_correct = NULL
help = NULL
for (i in 1:dim(a)[1]){
  tot_correct[i] = sum(a[i,], na.rm = T)
}

#adding how many weeks each person picked, season correct percentage, and adjusted season percentag to the data frame and sorting the data
indiv_disp = full_season %>% add_column(`Weeks Picked` = tot_week) %>%
  add_column(tot_correct)%>%
  add_column(tot_picks)%>%
  mutate(`Season Percent` = round(tot_correct/tot_picks,4))%>%
  mutate(`Adj Season Percent` = round(`Season Percent`*(tot_week/length(a)),4)) %>%
  select(-tot_correct, -tot_picks) %>%
  arrange(desc(Percent), desc(`Season Percent`)) %>%
  mutate(Percent = ifelse(is.na(Percent)==T, 0, Percent))
```


```{r individual percentages, include=FALSE}
#Calculating individual percentages for each week.
weekly_indiv_percent = map2(weekly_indiv, as.list(weekly_number_of_games), indiv_percent) %>% reduce(full_join, by = "Name")

weekly_indiv_percent_plot = weekly_indiv_percent %>% 
  pivot_longer(cols = starts_with("Week"), names_to = "Week", values_to = "Percent")%>%
  mutate(Percent = ifelse(is.na(Percent)==T, 0, Percent)) %>% 
  mutate(Week = as.factor(Week))

levels = NULL
for(i in 1:length(weeks)){
  levels[i] = glue("Week {i}")  
}

weekly_indiv_percent_plot = weekly_indiv_percent_plot %>%
  mutate(Week = factor(Week, levels))
```

```{r sparklines, include=FALSE}
#adding sparklines
plot_group = function(name, df){
  plot_object = 
    ggplot(data = df,
           aes(x = as.factor(Week), y=Percent, group = 1))+
    geom_path(size = 7)+
    scale_y_continuous(limits = c(0,1))+
    theme_void()+
    theme(legend.position = "none")
  return(plot_object)
}

sparklines = 
  weekly_indiv_percent_plot %>% 
  group_by(Name) %>% 
  nest() %>% 
  mutate(plot = map2(Name, data, plot_group)) %>% 
  select(-data)
  
indiv_disp_2 = indiv_disp %>% 
  inner_join(sparklines, by = "Name") %>% 
  mutate(`Season Trend` = NA)
```

```{r Printing Individual Table2, echo=FALSE}
# Printing the individual Table
indiv_table = indiv_disp_2 %>% gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Individual Results"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
   tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(Percent),
      rows = Percent<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(Percent),
      rows = Percent>.5
    )) %>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(indiv_disp_2$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(c(plot))

indiv_winners = indiv_disp_2 %>% filter(Percent == max(Percent)) %>% select(Name) %>% pull() %>% paste(collapse = ", ")
indiv_season = indiv_disp_2 %>% filter(`Season Percent` == max(`Season Percent`)) %>% select(Name) %>% pull() %>% paste(collapse = ", ")
indiv_season_adj = indiv_disp_2 %>% filter(`Adj Season Percent` == max(`Adj Season Percent`)) %>% select(Name) %>% pull()%>% paste(collapse = ", ")
```

```{r Printing Season Leaderboard, echo=FALSE}
# Printing the Season Leaderboard
  
season_leaderboard_disp = indiv_disp_2 %>% select(Name, starts_with("Week ")) %>% 
  pivot_longer(starts_with("Week"),names_to = "Week", values_to = "Correct") %>% 
  group_by(Week) %>% 
  mutate(Correct = case_when(is.na(Correct)==T~0, 
                             TRUE~Correct)) %>% 
  mutate(Donut = case_when(Correct==max(Correct)~1,
                           TRUE~0))  %>% 
  ungroup() %>% 
  group_by(Name) %>% 
  summarise(`Donuts Won` = sum(Donut)) %>% 
  #mutate(`Donuts Won` = strrep("award,", Donuts)) %>% 
  right_join(.,indiv_disp_2) %>% 
  select(-starts_with("Week "), -Percent) %>% 
  mutate(`Season Rank` = min_rank(desc(`Season Percent`)),.before = Name) %>% 
  arrange(`Season Rank`) 
  
season_leaderboard = season_leaderboard_disp %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Season Leaderboard (Season Percent)"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
  # fmt_icon(
  #   columns = `Donuts Won`,
  #   fill_color = "gold",
  # ) %>%
  tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(season_leaderboard_disp$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(columns = c(plot))
```

```{r Printing Adj Season Leaderboard, echo=FALSE}
# Printing the Adj Season Leaderboard
  
adj_season_leaderboard_disp = indiv_disp_2 %>% select(Name, starts_with("Week ")) %>% 
  pivot_longer(starts_with("Week"),names_to = "Week", values_to = "Correct") %>% 
  group_by(Week) %>% 
  mutate(Correct = case_when(is.na(Correct)==T~0, 
                             TRUE~Correct)) %>% 
  mutate(Donut = case_when(Correct==max(Correct)~1,
                           TRUE~0))  %>% 
  ungroup() %>% 
  group_by(Name) %>% 
  summarise(`Donuts Won` = sum(Donut)) %>% 
  #mutate(`Donuts Won` = strrep("award,", Donuts)) %>% 
  right_join(.,indiv_disp_2) %>% 
  select(-starts_with("Week "), -Percent) %>% 
  mutate(`Season Rank` = min_rank(desc(`Adj Season Percent`)),.before = Name) %>% 
  arrange(`Season Rank`)

adj_season_leaderboard = adj_season_leaderboard_disp %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Season Leaderboard (Adjusted Season Percent)"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
  # fmt_icon(
  #   columns = `Donuts Won`,
  #   fill_color = "gold",
  # ) %>%
  tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(adj_season_leaderboard_disp$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(columns = c(plot))
```


```{r instructor formattable, echo=FALSE}
improvement_formatter <- 
  formatter("span", 
            style = x ~ formattable::style(
              font.weight = "bold", 
              color = ifelse(x > .5, "green", ifelse(x < .5, "red", "black"))),
             x ~ icontext(ifelse(x == max(x), "star", ""), x))

indiv_disp_3 = indiv_disp_2 %>% select(-plot)
indiv_disp_3$`Season Trend` = apply(indiv_disp_3[,2:(1+length(weeks))], 1, FUN = function(x) as.character(htmltools::as.tags(sparkline(as.numeric(x), type = "line", chartRangeMin = 0, chartRangeMax = 1, fillColor = "white"))))

indiv_table_2 = as.htmlwidget(formattable(indiv_disp_3, 
                                align = c("l", rep("c", NROW(indiv_disp_3)-1)),
              list(`Season Percent` = color_bar("#FA614B"),
              `Season Percent`= improvement_formatter,
              `Adj Season Percent`= improvement_formatter)))
              
indiv_table_2$dependencies = c(indiv_table_2$dependencies, htmlwidgets:::widget_dependencies("sparkline", "sparkline"))
```

```{r Plotting individual results over the season2, eval=FALSE, include=FALSE, out.width="100%"}
#Creating the individual plot.  
inst_indiv_plots = weekly_indiv_percent_plot %>% 
  ggplot(aes(x = factor(Week), y = Percent, color = Name))+
  geom_point()+
  geom_path(aes(x = as.factor(Week), y = Percent, color = Name, 
                group = Name))+
  ylim(c(0, 1)) +
  labs(x = "NFL Week", 
       y = "Correct Percentage", 
       title = "Weekly Individual Correct Percentage")+
  facet_wrap(~Name)+
  theme_classic()+
  theme(legend.position = "none",
        plot.title = element_text(hjust = 0.5, size = 18),
        axis.text.x=element_text(angle =45, vjust = 1, hjust = 1))
```

```{r data for data page}
inst.data = map2(inst.picks, weeks, disp_data) %>% bind_rows()
```


```{r fivethirtyeight}
inst_538 = map(results, five38) %>% unlist() %>% sum()
```

```{r pregame, eval=FALSE, include=FALSE}
#Predictions for the week

#Creating the list of group predictions each week.
games = map(inst.picks, games_fn)

#Creating the prediction table.  
pred_table = map(games, pred_table_fn)

#Printing table of instructor predictions
pred_table[[length(pred_table)]] %>% mutate(Game = row_number()) %>% 
  rename(`Votes For` = votes_for, `Votes Against` = votes_against) %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("This Week's Predictions"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
   tab_options(
    data_row.padding = px(3)
   )
```

Group Predictions
==========================================================================

Sidebar {.sidebar} 
-------------------------------------
#### CBS Sports

<font size="4">

This week we beat or tied `r cbs_experts_beat[[length(weeks)]]` of `r cbs_experts_total[[length(weeks)]]` CBS Sports' Experts.

For the season we are currently beating or tied with `r cbs_experts_beat_season[[length(weeks)]]` of `r cbs_experts_season_total[[length(weeks)]]` CBS Sports' Experts.
 
 </font>


#### ESPN

<font size="4">

We also beat or tied `r espn_experts_beat[[length(weeks)]]` of `r espn_experts_total[[length(weeks)]]` ESPN Experts.
 
For the season we are currently beating or tied with `r espn_experts_beat_season[[length(weeks)]]` of `r espn_experts_season_total[[length(weeks)]]` ESPN Experts.

</font>

Row
--------------------------------------

### Win percentage for the week

```{r}
inst_rate <- weekly_win_percentage[[length(weekly_win_percentage)]]*100
gauge(inst_rate, min = 0, max = 100, symbol = '%', gaugeSectors(
  success = c(55, 100), warning = c(40, 54), danger = c(0, 39)
))
```

### Season Win Percentage

```{r}
inst_season <- season_win_percentage*100
gauge(inst_season, min = 0, max = 100, symbol = '%', gaugeSectors(
  success = c(55, 100), warning = c(40, 54), danger = c(0, 39)
))
```

### Games Correct
```{r}
valueBox(value = season_wins,icon = "fa-trophy",caption = "Correct Games this Season")
```

### Games Picked
```{r}
valueBox(value = season_games,icon = "fa-clipboard-list",caption = "Games Picked this Season")
```

### Number of predictions
```{r}
valueBox(value = Total,icon = "fa-users",caption = "Predictions this week")
```

Row
--------------------------------------

### 

```{r}
inst_group_table
```

### 

```{r}
ggplotly(inst_group_season_plot) %>% 
  layout(title = list(y = .93, xref = "plot"),
         margin = list(t = 40))
```

Individual Predictions
==========================================================================


Sidebar {.sidebar} 
-------------------------------------

#### Best Picks of the Week.

<font size="4">

 `r indiv_winners`
 
 </font>
 
#### Best Season Correct Percentage
<font size="4">

`r indiv_season`
 
 </font>

#### Best Adjusted Season Correct Percentage
<font size="4">

`r indiv_season_adj`

 * Adjusted season percentage accounts for the number of weeks picked.
 
 </font>

row {.tabset}
--------------------------------------

### Individual Table
```{r, results='asis', error=FALSE}
indiv_table
```

<!--
### Individual Table2

```{r, out.height="100%"}
indiv_table_2
```

-->

<!--

### Individual Plots
```{r, out.width="100%"}
#ggplotly(inst_indiv_plots)
```

-->

### Season Leaderboard
```{r, results='asis', error=FALSE}
season_leaderboard
```

### Adjusted Season Leaderboard
```{r, results='asis', error=FALSE}
adj_season_leaderboard
```

Data
==========================================================================

```{r}
datatable(
  inst.data, extensions = 'Buttons', options = list(
    dom = 'Blfrtip',
    buttons = c('copy', 'csv', 'excel', 'pdf', 'print'),
    lengthMenue = list( c(10, 25, 50, 100, -1), c(10, 25, 50, 100, "All") )
  )
)
```